home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s1.arc / DOSJUMP.MOD < prev    next >
Encoding:
Text File  |  1987-07-21  |  14.2 KB  |  392 lines
  1. (*----------------------------------------------------------------------*)
  2. (*                   Do_DosJump --- Jump to Dos                         *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE DosJump( Dos_String : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  DosJump;                                             *)
  10. (*                                                                      *)
  11. (*     Purpose:    Provides facility for jumping to DOS                 *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        DosJump( Dos_String : AnyStr );                               *)
  16. (*                                                                      *)
  17. (*           Dos_String --- DOS command to execute                      *)
  18. (*                                                                      *)
  19. (*     Calls:                                                           *)
  20. (*                                                                      *)
  21. (*        Execute_Dos_Command                                           *)
  22. (*        Open_For_Append                                               *)
  23. (*                                                                      *)
  24. (*----------------------------------------------------------------------*)
  25.  
  26. VAR
  27.    I            : INTEGER;
  28.    Ierr         : INTEGER;
  29.    Local_Save   : Saved_Screen_Ptr;
  30.    Open_Flag    : BOOLEAN;
  31.    Save_Cursor  : INTEGER;
  32.    Save_Status  : BOOLEAN;
  33.    Save_Video   : BOOLEAN;
  34.    Save_Border  : INTEGER;
  35.  
  36. (*----------------------------------------------------------------------*)
  37. (*   SetBlock --- Free up some memory above this program for DOS shell  *)
  38. (*----------------------------------------------------------------------*)
  39.  
  40. PROCEDURE SetBlock( Paras : INTEGER; Err_Val : INTEGER );
  41.  
  42. VAR
  43.    Regs : RegPack;
  44.  
  45. BEGIN (* SetBlock *)
  46.  
  47.    WITH Regs DO
  48.       BEGIN
  49.  
  50.          Ah := $4A;
  51.          Es := CSeg;
  52.          Bx := Paras;
  53.  
  54.          MsDos( Regs );
  55.  
  56.          IF ODD( Flags ) THEN
  57.             Err := Err_Val;
  58.  
  59.       END;
  60.  
  61. END   (* SetBlock *);
  62.  
  63. (*----------------------------------------------------------------------*)
  64. (*                InvokeDOS -- run any DOS command.                     *)
  65. (*----------------------------------------------------------------------*)
  66.  
  67. PROCEDURE InvokeDOS( Command : AnyStr );
  68.  
  69. VAR
  70.    M : INTEGER;
  71.  
  72. (*----------------------------------------------------------------------*)
  73.  
  74.     function SubProcess(CommandLine : AnyStr) : INTEGER;
  75.       {-From Bela Lubkin's EXEC.PAS}
  76.     const
  77.       SSSave : INTEGER = 0;
  78.       SPSave : INTEGER = 0;
  79.  
  80.     var
  81.       regs : RegPack;
  82.       FCB1, FCB2 : array[0..36] of Byte;
  83.       PathName : AnyStr;
  84.       CommandTail : AnyStr;
  85.       ParmTable : record
  86.                     EnvSeg : INTEGER;
  87.                     ComLin : ^INTEGER;
  88.                     FCB1Pr : ^INTEGER;
  89.                     FCB2Pr : ^INTEGER;
  90.                   end;
  91.       RegsFlags : INTEGER;
  92.  
  93.     begin
  94.       if Pos(' ', CommandLine) = 0 then begin
  95.         PathName := CommandLine+#0;
  96.         CommandTail := ^M;
  97.       end else begin
  98.         PathName := Copy(CommandLine, 1, PRED(Pos(' ', CommandLine)))+#0;
  99.         CommandTail := Copy(CommandLine, Pos(' ', CommandLine), 255)+^M;
  100.       end;
  101.       CommandTail[0] := PRED(CommandTail[0]);
  102.       with regs do begin
  103.         FillChar(FCB1, SizeOf(FCB1), 0);
  104.         Ax := $2901;
  105.         Ds := Seg(CommandTail[1]);
  106.         Si := Ofs(CommandTail[1]);
  107.         Es := Seg(FCB1);
  108.         Di := Ofs(FCB1);
  109.         MsDos(regs);          { Create FCB 1 }
  110.         FillChar(FCB2, SizeOf(FCB2), 0);
  111.         Ax := $2901;
  112.         Es := Seg(FCB2);
  113.         Di := Ofs(FCB2);
  114.         MsDos(regs);          { Create FCB 2 }
  115.         with ParmTable do begin
  116.           EnvSeg := MemW[CSeg:$002C];
  117.           ComLin := Addr(CommandTail);
  118.           FCB1Pr := Addr(FCB1);
  119.           FCB2Pr := Addr(FCB2);
  120.         end;
  121.         inline(
  122.           $8D/$96/PathName/$42/ { <DX>:=Ofs(PathName[1]); }
  123.           $8D/$9E/ParmTable/  { <BX>:=Ofs(ParmTable);   }
  124.           $B8/$00/$4B/        { <AX>:=$4B00;            }
  125.           $1E/$55/            { Save <DS>, <BP>         }
  126.           $16/$1F/            { <DS>:=Seg(PathName[1]); }
  127.           $16/$07/            { <ES>:=Seg(ParmTable);   }
  128.           $2E/$8C/$16/SSSave/ { Save <SS> in SSSave     }
  129.           $2E/$89/$26/SPSave/ { Save <SP> in SPSave     }
  130.           $FC/                { CLD}
  131.           $FA/                { Disable interrupts      }
  132.           $CD/$21/            { Call MS-DOS             }
  133.           $FA/                { Disable interrupts      }
  134.           $2E/$8B/$26/SPSave/ { Restore <SP>            }
  135.           $2E/$8E/$16/SSSave/ { Restore <SS>            }
  136.           $FB/                { Enable interrupts       }
  137.           $5D/$1F/            { Restore <BP>,<DS>       }
  138.           $9C/$8F/$86/RegsFlags/ { RegsFlags:=<CPU flags>}
  139.           $89/$86/regs);      { Regs.AX:=<AX>;          }
  140.         if Odd(RegsFlags) then
  141.           SubProcess := Ax
  142.         else
  143.           SubProcess := 0;
  144.       end;
  145.     end;                      {SubProcess}
  146.  
  147. (*----------------------------------------------------------------------*)
  148.  
  149. BEGIN (* InvokeDOS *)
  150.                                    (* Assume no error yet *)
  151.    Err := 0;
  152.                                    (* Save current stack seg and ptr *)
  153.    INLINE(
  154.             $8C/$D0/                {MOV    AX,SS}
  155.             $A3/StackSeg/           {MOV    StackSeg,AX}
  156.             $89/$26/StackPtr        {MOV    StackPtr,SP}
  157.          );
  158.                                    (* The new lower stack goes above the *)
  159.                                    (* "high water mark" of the heap.     *)
  160.                                    (* Heap fragmentation may cause       *)
  161.                                    (* HeapPtr to be higher than you      *)
  162.                                    (* expect                             *)
  163.  
  164.    NewStackSeg := SUCC( Seg ( HeapPtr^ ) );
  165.    NewStackPtr := NewStackSize;
  166.  
  167.                                    (* Current DOS memory allocation read *)
  168.                                    (* from memory control block          *)
  169.  
  170.    ParasWeHave := MemW[ PRED( CSeg ):3 ];
  171.    ParasToKeep := SUCC( NewStackSeg - CSeg ) + SUCC( NewStackSize SHR 4 );
  172.    ParasForDos := ParasWeHave - ParasToKeep;
  173.  
  174.                                    (* See if enough memory to run DOS *)
  175.  
  176.    IF ( ParasForDos > 0 ) AND ( ParasForDos < ( MinDOSspace SHR 4 ) ) THEN
  177.       BEGIN
  178.          WRITELN('Too little memory to jump to DOS');
  179.          Err := 3;
  180.          EXIT;
  181.       END;
  182.                                    (* See if enough stack buffer to   *)
  183.                                    (* store current Turbo stack       *)
  184.  
  185.    IF ( SUCC( TopOfStack - StackPtr ) > StackBufferSize ) THEN
  186.       BEGIN
  187.          M := SUCC( TopOfStack - StackPtr );
  188.          WRITELN('Too little memory for internal stack buffer;');
  189.          WRITELN('Needed ', M, ' bytes, only ',StackBufferSize,
  190.                  ' bytes available.');
  191.          Err := 4;
  192.          EXIT;
  193.       END;
  194.                                    (* Build the Command string *)
  195.  
  196.    CommandStr := GetEnvStr( 'COMSPEC' );
  197.  
  198.    IF ( LENGTH( Command ) > 0 ) THEN
  199.       CommandStr := CommandStr + ' /C ' + Command;
  200.  
  201.    M := ( ParasForDos - 240 ) SHR 6;
  202.    WRITELN('Approximate memory available: ', M, 'K');
  203.  
  204.                                    (* Copy the top of the stack to a buffer *)
  205.  
  206.    MOVE( MEM[ StackSeg:StackPtr ], StackBuffer, SUCC( TopOfStack - StackPtr ) );
  207.  
  208.                                    (* Lower stack *)
  209.    INLINE(
  210.            $FA/                    {CLI    }
  211.            $A1/NewStackSeg/        {MOV    AX,newStackSeg}
  212.            $8E/$D0/                {MOV    SS,AX}
  213.            $8B/$26/NewStackPtr/    {MOV    SP,newStackPtr}
  214.            $FB                     {STI    }
  215.          );
  216.  
  217.                                    (* Deallocate memory for DOS *)
  218.    SetBlock( ParasToKeep , 1 );
  219.                                    (* Run the DOS command *)
  220.    IF ( Err = 0 ) THEN
  221.       ExecStatus := SubProcess( CommandStr )
  222.    ELSE
  223.       ExecStatus := 0;
  224.                                    (* Reallocate memory from DOS *)
  225.    SetBlock( ParasWeHave , 2 );
  226.                                    (* Restore stack seg and ptr to original values *)
  227.    INLINE(
  228.            $FA/                    {CLI    }
  229.            $A1/StackSeg/           {MOV    AX,StackSeg}
  230.            $8E/$D0/                {MOV    SS,AX}
  231.            $8B/$26/StackPtr/       {MOV    SP,StackPtr}
  232.            $FB                     {STI    }
  233.          );
  234.                                    (* Put stack buffer back on stack *)
  235.  
  236.    MOVE( StackBuffer, MEM[ StackSeg:StackPtr ], SUCC( TopOfStack - StackPtr ) );
  237.  
  238.    IF( ExecStatus <> 0 ) THEN
  239.       BEGIN
  240.          WRITELN('Error in jump to DOS');
  241.          Err := 5;
  242.       END;
  243.  
  244. END   (* InvokeDOS *);
  245.  
  246. (*----------------------------------------------------------------------*)
  247. (*   SubProcessReturnCode --- return error code from executed Command   *)
  248. (*----------------------------------------------------------------------*)
  249.  
  250. FUNCTION SubProcessReturnCode: INTEGER;
  251.  
  252. VAR
  253.    Regs : RegPack;
  254.  
  255. BEGIN (* SubProcessReturnCode *)
  256.  
  257.     Regs.AH := $4D;
  258.     MsDos( Regs );
  259.  
  260.     SubProcessReturnCode := Regs.AX;
  261.  
  262. END   (* SubProcessReturnCode *);
  263.  
  264. (*----------------------------------------------------------------------*)
  265.  
  266. BEGIN (* DosJump *)
  267.                                    (* Save screen contents *)
  268.    Save_Screen( Local_Save );
  269.  
  270.    Window( 1, 1, Max_Screen_Col, Max_Screen_Line );
  271.    Scroll( 1, Max_Screen_Line, 1, Max_Screen_Col, 0,
  272.            LightGray, Black );
  273.    Save_Border := Global_Border_Color;
  274.    Set_Border_Color( Black );
  275.    GoToXY( 1 , 1 );
  276.  
  277.    Save_Status    := Do_Status_Time;
  278.    Do_Status_Time := FALSE;
  279.  
  280.    IF ( LENGTH( Dos_String ) = 0 ) THEN
  281.       BEGIN
  282.          WRITELN;
  283.          WRITELN('Jump to DOS:  Enter EXIT to return to PibTerm');
  284.       END;
  285.                                    (* Turn off extended keypad *)
  286.    IF Extended_Keypad THEN
  287.       Remove_Keyboard_Handler;
  288.                                    (* Turn off video handler   *)
  289.  
  290.    Save_Video := Video_Handler_Installed;
  291.  
  292.    IF Save_Video THEN
  293.       Remove_Video_Handler;
  294.                                    (* Close capture file *)
  295.    IF Capture_On THEN
  296.          (*$I-*)
  297.       CLOSE( Capture_File );
  298.          (*$I+*)
  299.                                    (* Close log file *)
  300.    IF Log_File_Open THEN
  301.          (*$I-*)
  302.       CLOSE( Log_File );
  303.          (*$I+*)
  304.  
  305.    I := Int24Result;
  306.                                    (* Remove Int 24 error handler *)
  307.    Int24OFF;
  308.                                    (* Close communications if requested *)
  309.    IF Close_Comm_For_Dos THEN
  310.       Async_Close( FALSE );
  311.                                    (* Save current cursor    *)
  312.    CursorGet( Save_Cursor );
  313.                                    (* Change cursor to block *)
  314.    IF Current_Video_Mode = 7 THEN
  315.       CursorSet( $010D )
  316.    ELSE
  317.       CursorSet( $0107 );
  318.                                    (* Jump to DOS *)
  319.    InvokeDos( Dos_String );
  320.    Ierr := SubProcessReturnCode;
  321.                                    (* Change cursor back to underline *)
  322.    CursorSet( Save_Cursor );
  323.                                    (* Reset EGA if needed         *)
  324.    IF EGA_Installed THEN
  325.       Set_EGA_Text_Mode( Max_Screen_Line );
  326.  
  327.                                    (* Restore Int24 Error handler *)
  328.    Int24ON;
  329.                                    (* Restore communications.  Port *)
  330.                                    (* opened twice in case major    *)
  331.                                    (* weirdness causes first open   *)
  332.                                    (* to screw up.                  *)
  333.    IF Close_Comm_For_Dos THEN
  334.       FOR I := 1 TO 2 DO
  335.          Open_Flag  := Async_Open( Comm_Port, Baud_Rate, Parity, Data_Bits,
  336.                                    Stop_Bits )
  337.    ELSE
  338.       Async_Clear_Errors;
  339.  
  340.    CASE Err OF
  341.       0: WRITELN('Back to PibTerm, DOS return code is ',I);
  342.       1: WRITELN('Set Block error, DOS jump cannot be done');
  343.       2: BEGIN
  344.             WRITELN('Set Block error on return from DOS, PibTerm cannot continue.');
  345.             WRITELN('You will probably need to re-boot.');
  346.             Turbo_Halt( 2 );
  347.          END;
  348.       ELSE;
  349.    END (* CASE *);
  350.                                    (* Reopen capture file for append *)
  351.    IF Capture_On THEN
  352.       BEGIN
  353.  
  354.          IF ( NOT Open_For_Append( Capture_File , Capture_File_Name , I ) ) THEN
  355.             BEGIN
  356.                WRITELN('Can''t re-open capture file ',
  357.                         Capture_File_Name);
  358.                WRITELN('Capture option TURNED OFF.');
  359.                Capture_On := FALSE;
  360.                DELAY( One_Second_Delay );
  361.             END;
  362.  
  363.       END;
  364.                                    (* Reopen log file for append *)
  365.    IF Logging_On THEN
  366.       Log_File_Open := Open_For_Append( Log_File,
  367.                                         Log_File_Name, I );
  368.  
  369.                                    (* If we got here from Alt-J,  *)
  370.                                    (* or request for shell in     *)
  371.                                    (* script, then wait for a key *)
  372.                                    (* to be struck.               *)
  373.  
  374.    IF ( LENGTH( Dos_String ) = 0 ) OR
  375.       ( ( ( Err <> 0 ) OR ( Ierr <> 0 ) ) AND Attended_Mode ) THEN
  376.       Press_Any;
  377.                                    (* Restore screen contents *)
  378.    Restore_Screen( Local_Save );
  379.    Reset_Global_Colors;
  380.    Set_Border_Color( Save_Border );
  381.  
  382.                                    (* Restore status line updating *)
  383.    Do_Status_Time := Save_Status;
  384.                                    (* Restore extended keyboard    *)
  385.    IF Extended_Keypad THEN
  386.       Install_Keyboard_Handler;
  387.                                    (* Restore video handler        *)
  388.    IF Save_Video THEN
  389.       Install_Video_Handler;
  390.  
  391. END   (* DosJump *);
  392.